home *** CD-ROM | disk | FTP | other *** search
- ⓪ MODULE SignumRead;⓪ ⓪ (*⓪!* 19.02.92: '1' und '2' waren vertauscht.⓪!*)⓪ ⓪ (*⓪!* '#' markieren Fußnoten⓪!* '@' stehen dort, wo Zeichen dichter als ihre Proportionen aufeinander liegen⓪!* '@@@' markiert einen Bruch im Text⓪!*)⓪ ⓪ IMPORT TOSIO, SimpleError;⓪ ⓪ FROM InOut IMPORT Write, WriteLn, WriteString, WriteCard, FlushKbd, WritePg,⓪(WriteLHex, BusyRead, Read;⓪ ⓪ FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD, ASSEMBLER;⓪ ⓪ FROM GEMEnv IMPORT RC, InitGem, DeviceHandle;⓪ ⓪ FROM EasyGEM0 IMPORT HideMouse;⓪ ⓪ FROM EasyGEM1 IMPORT SelectMask, SelectFile;⓪ ⓪ FROM FileNames IMPORT ConcatPath;⓪ ⓪ FROM Strings IMPORT Compare, Relation, String, Concat, Assign, Insert, Empty,⓪(Append;⓪ ⓪ FROM Binary IMPORT ReadBytes, ReadBlock, FilePos, FileSize;⓪ ⓪ IMPORT Text;⓪ ⓪ FROM Files IMPORT File, Open, Create, Close, Access, ReplaceMode,⓪(EOF, State, ResetState;⓪ ⓪ FROM Storage IMPORT DEALLOCATE;⓪ IMPORT Storage;⓪ ⓪ PROCEDURE ALLOCATE (VAR ad: ADDRESS; l: LONGCARD);⓪"BEGIN⓪$WriteLn;⓪$WriteString ('ALLOCATE: ');⓪$WriteCard (l,0);⓪$WriteLn;⓪$Storage.ALLOCATE (ad, l)⓪"END ALLOCATE;⓪ ⓪ ⓪ VAR out: File;⓪$chsnames: ARRAY [0..7], [0..9] OF CHAR;⓪$chOffset: ARRAY [0..7], [0..127] OF LONGCARD;⓪$font: ARRAY [0..7] OF ADDRESS;⓪$spaceWidth: INTEGER;⓪ ⓪ TYPE Str255 = ARRAY [0..255] OF CHAR;⓪ ⓪ PROCEDURE Space ( n: INTEGER ): Str255;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE -(A3),D0⓪(MOVE.L A3,A0⓪(ADDA.W #256,A3⓪(MOVEQ #' ',D1⓪(BRA C⓪&L MOVE.B D1,(A0)+⓪&C SUBQ #1,D0⓪(BPL L⓪(CLR.B (A0)+⓪$END⓪"END Space;⓪"(*$L=*)⓪ ⓪ PROCEDURE wait;⓪"VAR c: CHAR;⓪"BEGIN⓪$FlushKbd;⓪$Read (c)⓪"END wait;⓪ ⓪ TYPE⓪ ⓪ (*⓪"DocHead = RECORD⓪2kenn: ARRAY [0..7] OF CHAR;⓪2lg: LONGCARD;⓪2div: ARRAY [0..127] OF CHAR⓪0END;⓪ ⓪"ChsBlock = RECORD⓪2kenn: ARRAY [0..3] OF CHAR;⓪2lg: LONGCARD;⓪0END;⓪ ⓪"Par1Block = RECORD⓪2kenn: ARRAY [0..3] OF CHAR;⓪2lg: LONGCARD;⓪2tabs: ARRAY [1..40] OF INTEGER;⓪2list: ARRAY [1..15] OF INTEGER;⓪0END;⓪ ⓪"PageBlock = RECORD⓪2kenn: ARRAY [0..3] OF CHAR;⓪2lg: LONGCARD;⓪2pages: LONGCARD;⓪2kl: LONGCARD;⓪2firstPnr: LONGCARD;⓪2unused: ARRAY [0..5] OF LONGCARD⓪0END;⓪ ⓪"Page = RECORD⓪2index: INTEGER;⓪2physPnr: INTEGER;⓪2logPnr: INTEGER;⓪2lines: INTEGER;⓪2lmargin: INTEGER;⓪2rmargin: INTEGER;⓪2tmargin: INTEGER;⓪2bmargin: INTEGER;⓪2numbpos: INTEGER;⓪2kapitel: INTEGER;⓪2intern: INTEGER;⓪2unused: ARRAY [1..8] OF INTEGER⓪0END;⓪ ⓪"TextHead = RECORD⓪2kenn: ARRAY [0..3] OF CHAR;⓪2lg: LONGCARD;⓪2lines: LONGCARD;⓪2text: WORD (* ... *)⓪0END;⓪ ⓪"Zeile = RECORD⓪2blLines: CARDINAL;⓪2codeLen: CARDINAL;⓪2code: CHAR (*...*)⓪0END;⓪ ⓪"LineBit = (unused0, unused1,⓪1hauptZeile, absatz, formel, pgEnd, pgBegin, nonEdit);⓪"LineBits = SET OF LineBit;⓪ ⓪"DescBits = SET OF [0..7];⓪"DescWord = WORD;⓪ *)⓪ ⓪"Char = RECORD⓪2CASE : CARDINAL OF⓪2| 1: mode: INTEGER; (* negativ -> 'short' Modus *)⓪2| 2: short: WORD⓪2| 4: low: WORD; high: WORD⓪2END;⓪0END;⓪ ⓪"PtrChar = POINTER TO Char;⓪ ⓪ ⓪ PROCEDURE taste (): BOOLEAN;⓪"VAR ch: CHAR;⓪"BEGIN⓪$BusyRead (ch);⓪$IF ch # 0C THEN⓪&FlushKbd;⓪&IF ch = 33C THEN RETURN TRUE END;⓪&Read (ch);⓪&IF ch = 33C THEN RETURN TRUE END;⓪$END;⓪$RETURN FALSE⓪"END taste;⓪ ⓪ PROCEDURE toASCII (no: CARDINAL): CHAR;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE -(A3),D0⓪(LEA tab(PC),A0⓪(MOVE.B 0(A0,D0.W),(A3)+⓪(ADDQ.L #1,A3⓪(RTS⓪&tab:⓪(ASC ' ()/*0123456789'⓪(ASC '()/*0123456789'⓪(ASC '+-.§!"#$'⓪(ASC "%&'()*+,-./"⓪(ASC '0123456789'⓪(ASC ':;<=>?ü'⓪(ASC 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'⓪(ASC 'öÜä^_`'⓪(ASC 'abcdefghijklmnopqrstuvwxyz'⓪(ASC 'Ö|Ä~ß@@@@@@@@@@@@@@@@@@@@@'⓪(SYNC⓪$END⓪"END toASCII;⓪"(*$L=*)⓪ ⓪ PROCEDURE decode (VAR sc: Char;⓪2VAR ofs: INTEGER; VAR chNo: CARDINAL; VAR width: INTEGER;⓪2VAR footNote: BOOLEAN): BOOLEAN;⓪"VAR fontNo: INTEGER;⓪&ok: BOOLEAN;⓪&p: POINTER TO CHAR;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L footNote(A6),A2⓪(MOVE.L sc(A6),A0⓪(⓪(MOVE.W (A0),D2⓪(MOVE.W D2,D1⓪(ANDI #$7F,D2⓪(BEQ error⓪(MOVE.L chNo(A6),A1⓪(MOVE D2,(A1)⓪(⓪(MOVE.L (A0),D0⓪(BPL l⓪(⓪(SWAP D0⓪(ROL.W #7,D0⓪(ANDI #$003F,D0⓪(LSR.W #7,D1⓪(ANDI #3,D1⓪(CLR.W (A2) ; keine Fußnote⓪(BRA e⓪ ⓪%error⓪(CLR ok(A6)⓪(BRA ee⓪ ⓪%l BTST #10,D1⓪(SNE D2⓪(ANDI #1,D2⓪(MOVE D2,(A2) ; Fußnote⓪(⓪(BTST #11,D0⓪(BEQ n1⓪(BTST #12,D0⓪(BNE error ; groß- und kleinschrift geht nicht⓪%n1 MOVE D1,D2⓪(ANDI #0011100000000000%,D2⓪(BNE error ; reserviert - müssen Null sein⓪ ⓪(ANDI #$07FF,D0⓪(LSR.W #7,D1⓪(ANDI #7,D1⓪(⓪%e MOVE.L ofs(A6),A0⓪(MOVE D0,(A0)⓪(MOVE D1,fontNo(A6)⓪(MOVE #1,ok(A6)⓪ ⓪%ee⓪$END;⓪$IF NOT ok OR (font [fontNo] = NIL) THEN⓪&RETURN FALSE⓪$END;⓪$p:= font [fontNo] + chOffset [fontNo][chNo] + 2L;⓪$width:= ORD (p^);⓪$(*⓪&Write (toASCII (sc));⓪&WriteCard (chNo, 4);⓪&WriteCard (fontNo, 2);⓪&WriteCard (spc, 3);⓪&IF taste () THEN HALT END;⓪&ASSEMBLER⓪*MOVE.L p(A6),A0⓪*BREAK⓪&END;⓪&WriteCard (ORD (p^), 3);⓪&WriteLn;⓪$*)⓪$RETURN TRUE⓪"END decode;⓪ ⓪ PROCEDURE advChar (VAR p: PtrChar);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A0⓪(MOVE.L (A0),A1⓪(TST.W (A1)⓪(BMI w⓪(ADDQ.L #4,(A0)⓪(RTS⓪&w ADDQ.L #2,(A0)⓪$END⓪"END advChar;⓪"(*$L=*)⓪ ⓪ PROCEDURE peek (VAR p: ADDRESS; VAR d: ARRAY OF BYTE);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W -(A3),D1⓪(MOVE.L -(A3),A1⓪(MOVE.L -(A3),A0⓪(MOVE.L (A0),A2⓪&L MOVE.B (A2)+,(A1)+⓪(DBRA D1,L⓪(MOVE.L A2,(A0)⓪$END⓪"END peek;⓪"(*$L=*)⓪ ⓪ PROCEDURE wrln;⓪"BEGIN⓪$Text.WriteLn (out);⓪"END wrln;⓪ ⓪ PROCEDURE wrstr (s: ARRAY OF CHAR);⓪"BEGIN⓪$Text.WriteString (out, s)⓪"END wrstr;⓪ ⓪ PROCEDURE wr (c: CHAR);⓪"BEGIN⓪$Text.Write (out, c)⓪"END wr;⓪ ⓪ PROCEDURE wrpg;⓪"BEGIN⓪$Text.WritePg (out)⓪"END wrpg;⓪ ⓪ PROCEDURE beginOfPage (p: ADDRESS): BOOLEAN;⓪"BEGIN⓪$INC (p,2);⓪$IF p^ # WORD (4) THEN RETURN FALSE END;⓪$INC (p,2);⓪$IF p^ # WORD ($C080) THEN RETURN FALSE END;⓪$INC (p,2);⓪$RETURN p^ # WORD (0)⓪"END beginOfPage;⓪ ⓪ ⓪ PROCEDURE parseText (ad: ADDRESS; len: LONGCARD);⓪"⓪"VAR p: PtrChar;⓪&lastp, endp: ADDRESS;⓪&lastseite, seite: CARDINAL;⓪&error: BOOLEAN;⓪ ⓪"PROCEDURE scan (VAR p: PtrChar): BOOLEAN;⓪$VAR chNo, blankLines, c1, c2, c3: CARDINAL;⓪(ofs, lastWidth, width, i1, i2, i3: INTEGER;⓪(l1, l2, l3: LONGCARD;⓪(ch: CHAR;⓪(sc: Char;⓪(flag: SET OF [0..7];⓪(p2: ADDRESS;⓪(pos: CARDINAL;⓪(lastFoot, footNote, ok: BOOLEAN;⓪(s: ARRAY [0..255] OF CHAR;⓪$BEGIN⓪&(* Zeilenbeginn *)⓪&peek (p, blankLines);⓪&peek (p, c1);⓪&IF c1 > 10000 THEN RETURN FALSE END;⓪&p2:= ADDRESS (p) + LONG (c1);⓪&peek (p, flag);⓪&IF 7 IN flag THEN⓪(IF 5 IN flag THEN⓪*(*⓪,wrpg ();⓪**)⓪(ELSIF 6 IN flag THEN⓪*WriteString ('Seite ');⓪*WriteCard (seite,0);⓪*WriteLn;⓪*INC (seite)⓪(ELSE⓪*(* eines von beiden muß es sein! *)⓪*error:= TRUE;⓪*RETURN FALSE;⓪(END⓪&ELSIF 3 IN flag THEN⓪(wrln () (* Absatz *)⓪&END;⓪&peek (p, flag);⓪&FOR c2:= 0 TO 7 DO⓪(IF c2 IN flag THEN⓪*peek (p, c3);⓪(END⓪&END;⓪&pos:= 0; lastWidth:= 0;⓪&lastFoot:= FALSE;⓪&LOOP⓪(IF ADDRESS (p) >= p2 THEN EXIT END;⓪((* jedes Zeichen der Zeile *)⓪(IF NOT decode (p^, ofs, chNo, width, footNote) THEN⓪*error:= TRUE;⓪*RETURN FALSE⓪(END;⓪(IF ofs < lastWidth THEN⓪*s[pos]:= '@';⓪*INC (pos)⓪(ELSE⓪*FOR i2:= 1 TO (ofs - lastWidth + spaceWidth - 4) DIV spaceWidth DO⓪,IF pos >= SIZE (s) THEN RETURN FALSE END;⓪,s[pos]:= ' ';⓪,INC (pos);⓪*END;⓪(END;⓪(IF pos >= SIZE (s) THEN RETURN FALSE END;⓪(lastWidth:= width;⓪(IF footNote THEN⓪*IF NOT lastFoot THEN⓪,lastFoot:= TRUE;⓪,s[pos]:= '#';⓪,INC (pos);⓪,IF pos >= SIZE (s) THEN RETURN FALSE END;⓪*END⓪(ELSE⓪*lastFoot:= FALSE⓪(END;⓪(s[pos]:= toASCII (chNo);⓪(INC (pos);⓪(IF pos >= SIZE (s) THEN RETURN FALSE END;⓪(advChar (p);⓪&END;⓪&⓪&IF pos > 0 THEN⓪(s[pos]:= 0C;⓪(wrstr (s);⓪&END;⓪&wrln ();⓪$⓪&IF error THEN RETURN FALSE END;⓪$⓪&RETURN TRUE⓪$END scan;⓪ ⓪"BEGIN⓪$endp:= ad + len;⓪$(* rest vom header überlesen *)⓪$seite:= 1;⓪$p:= ad + 4L;⓪$ASSEMBLER⓪*MOVE.L p(A6),A0⓪*; BREAK⓪$END;⓪$⓪$(* zeilen lesen *)⓪$REPEAT⓪&⓪&error:= FALSE;⓪&⓪&LOOP⓪(lastp:= p;⓪(⓪((*⓪*IF ~(scan (p) & scan (p) & scan (p) & scan (p) & scan (p) & scan (p)) THEN⓪,p:= lastp+2;⓪*END;⓪(*)⓪(IF scan (p) THEN END;⓪(⓪(IF p >= endp THEN EXIT END;⓪&END; (* LOOP *)⓪&⓪&IF error THEN⓪(wrln ();⓪(wrstr ('@@@');⓪(wrln ();⓪(wrln ();⓪(WriteString ('Bruch!'); WriteLn;⓪(⓪(IF ODD (p) THEN INC (p) END;⓪((*⓪(REPEAT⓪*INC (p,2);⓪(UNTIL beginOfPage (p) OR (ADDRESS (p) >= endp)⓪(*)⓪&END;⓪ ⓪$UNTIL ADDRESS (p) >= endp;⓪"END parseText;⓪ ⓪ PROCEDURE readFont (n: CARDINAL);⓪"VAR⓪$s8: ARRAY [0..7] OF CHAR;⓪$len, lc: LONGCARD;⓪$buf: ADDRESS;⓪$ok: BOOLEAN;⓪$s: String;⓪$f: File;⓪"BEGIN⓪$Concat (chsnames [n], '.E24', s, ok);⓪$ConcatPath (SelectMask, s, SelectMask);⓪$SelectFile ('Font?', s, ok);⓪$WritePg;⓪$IF NOT ok THEN RETURN END;⓪$Open (f, s, readOnly);⓪$⓪$ReadBlock (f, s8);⓪$IF Compare ('eset0001', s8) # equal THEN⓪&WriteString ("Dies ist keine Font-Datei!");⓪&wait;⓪&RETURN⓪$END;⓪$⓪$ReadBlock (f, lc);⓪$ALLOCATE (buf, lc);⓪$IF buf = NIL THEN WriteString ('Out of mem'); wait; RETURN END;⓪$ReadBytes (f, buf, lc, len);⓪$IF lc # len THEN⓪&WriteString ("EOF!");⓪&wait;⓪$END;⓪$DEALLOCATE (buf, lc);⓪$⓪$ReadBlock (f, chOffset[n]);⓪$ALLOCATE (font[n], chOffset[n][0]);⓪$IF font[n] = NIL THEN WriteString ('Out of mem'); wait; RETURN END;⓪$ReadBytes (f, font[n], chOffset[n][0], len);⓪$IF chOffset[n][0] # len THEN⓪&WriteString ("EOF!");⓪&wait;⓪$END;⓪$Close (f);⓪"END readFont;⓪ ⓪ VAR f: File;⓪$ok: BOOLEAN;⓪$s: String;⓪$s8: ARRAY [0..7] OF CHAR;⓪$s4: ARRAY [0..3] OF CHAR;⓪$c: CARDINAL;⓪$i: CARDINAL;⓪$len, lc: LONGCARD;⓪$fonts: BOOLEAN;⓪$buf: ADDRESS;⓪$dev: DeviceHandle;⓪ ⓪ BEGIN⓪"InitGem (RC, dev, ok);⓪"HideMouse;⓪"WritePg;⓪"SelectMask:= '*.sdo';⓪"s:= '';⓪"SelectFile ('Signum-Datei zum Lesen', s, ok);⓪"WritePg;⓪"IF NOT ok THEN RETURN END;⓪"Open (f, s, readOnly);⓪"⓪"spaceWidth:= 9;⓪"⓪"ReadBlock (f, s8);⓪"IF Compare ('sdoc0001', s8) # equal THEN⓪$WriteString ("Dies ist keine Signum-Datei!");⓪$wait;⓪$RETURN⓪"END;⓪"⓪"(* Info-Blocks überlesen *)⓪"s4:= '';⓪"fonts:= FALSE;⓪"LOOP⓪$ReadBlock (f, lc);⓪$IF Compare ('cset', s4) = equal THEN⓪&fonts:= TRUE;⓪&ReadBlock (f, chsnames);⓪&FOR i:= 0 TO 6 DO⓪(IF NOT Empty (chsnames[i]) THEN⓪*readFont (i);⓪(END⓪&END⓪$ELSE⓪&(* geht nur, wenn die Blöcke fehlerfrei sind:⓪(ALLOCATE (buf, lc);⓪(IF buf = NIL THEN WriteString ('Out of mem'); wait; RETURN END;⓪(ReadBytes (f, buf, lc, len);⓪(IF lc # len THEN⓪*WriteString ("EOF vor 'tebu'!");⓪*wait;⓪*RETURN⓪(END;⓪(DEALLOCATE (buf, lc);⓪&*)⓪&IF fonts THEN⓪(EXIT (* damit werden auch die restlichen Blocks als Text geladen *)⓪&END⓪$END;⓪$ReadBlock (f, s4);⓪$IF Compare ('tebu', s4) = equal THEN EXIT END;⓪"END;⓪"⓪"(*⓪#* Text einlesen⓪#*)⓪"(* Länge der Text-Daten: ReadBlock (f, lc); *)⓪"lc:= FileSize (f) - FilePos (f); (* Ganzen Datei-Rest lesen *)⓪"WriteString ('Textpos: '); WriteLHex (FilePos(f), 0); WriteLn;⓪"WriteString ('Textlänge: '); WriteLHex (lc, 0); WriteLn;⓪"ALLOCATE (buf, lc);⓪"IF buf = NIL THEN WriteString ('Out of mem'); wait; RETURN END;⓪"ReadBytes (f, buf, lc, len);⓪"IF lc # len THEN⓪$WriteString ("Datei ist zu kurz! Weiter...");⓪$wait;⓪$WriteLn;⓪"END;⓪"⓪"Close (f);⓪ ⓪"SelectMask:= '*.txt';⓪"s:= 'output.txt';⓪"SelectFile ('Ausgabe-Datei', s, ok);⓪"WritePg;⓪"IF NOT ok THEN RETURN END;⓪"Create (out, s, writeOnly, replaceOld);⓪"WriteString ('Start...');⓪"WriteLn;⓪"parseText (buf, len);⓪"Close (out);⓪ ⓪"WriteLn;⓪"WriteString ('Ende');⓪"wait⓪ END SignumRead.⓪ ə
- (* $FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$00001AB9$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7$FFED8BD7Ç$00000050T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$000026CD$0000289A$000028FE$00002A91$00002ADD$00002ABD$00000E11$00000050$00002B34$00002ADD$00002096$00002111$0000208C$000026D7$000028AB$0000289AáÇé*)
-
